home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / CRT.SWG / 0029_CRT Text device drive.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  2KB  |  66 lines
  1. {
  2.  AN> How would I go about writing an Internal Screen Driver????
  3.  
  4. It's named somewhat different in the manual, and explained there, Text driver
  5. or something, but here is an example I posted a couple of weeks before, to play with.
  6.  
  7. { Small program to demostrate redirection of TP's Output variable }
  8. { Arne de Bruijn, 1994, PD }
  9.  
  10. Unit NewCrt;
  11. interface
  12. procedure AssignCrt(var F:text);
  13. implementation
  14. uses Dos; {For TextRec, fmClosed, fmOutput}
  15.  
  16. function InOutCrtOut(var F:text):byte; far; assembler;
  17. asm
  18.  cld                          { Count forwards }
  19.  mov dx,ds                    { Save DS }
  20.  lds si,F                     { Get address of F }
  21.  mov cx,[si].TextRec.BufPos   { Get number of bytes to write }
  22.  lds si,[si].TextRec.BufPtr   { Get address of buffer }
  23. @OutChars:
  24.  lodsb                        { Load character to output in AL, and }
  25.                               { set SI to next character }
  26.  int 29h                      { Output AL with DOS undocumented fast write }
  27.  loop @OutChars               { Do all characters (dec(cx); until cx=0) }
  28.  mov ds,dx                    { Restore DS }
  29. end;
  30.  
  31. function CloseCrtOut(var F:text):byte; far;
  32. begin
  33.  TextRec(F).Mode:=fmClosed;
  34.  CloseCrtOut:=0;
  35. end;
  36.  
  37. function OpenCrtOut(var F:text):byte; far;
  38. begin
  39.  with TextRec(F) do
  40.   begin
  41.    Mode:=fmOutput;
  42.    BufPos:=0; BufEnd:=0;
  43.    InOutFunc:=@InOutCrtOut;
  44.    FlushFunc:=@InOutCrtOut;
  45.    CloseFunc:=@CloseCrtOut;
  46.   end;
  47.  OpenCrtOut:=0;
  48. end;
  49.  
  50. procedure AssignCrt(var F:text);
  51. begin
  52.  with TextRec(F) do
  53.   begin
  54.    Mode:=fmClosed;
  55.    BufSize:=SizeOf(Buffer);
  56.    BufPtr:=@Buffer;
  57.    Name[0]:=#0;
  58.    OpenFunc:=@OpenCrtOut;
  59.   end;
  60. end;
  61.  
  62. begin
  63.  AssignCrt(Output);
  64.  Rewrite(Output);
  65. end.
  66.